home *** CD-ROM | disk | FTP | other *** search
/ Nautilus 1992 July / Nautilus-3-8 / Nautilus-3-8.bin / Tools & Utilities / Techy Stuff / Development Environments ƒ / Perl 4.0.2 ƒ / usersub.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-01-11  |  4.0 KB  |  190 lines
  1. /* $RCSfile: usersub.c,v $$Revision: 4.0.1.1 $$Date: 91/11/11 16:47:17 $
  2.  *
  3.  *  This file contains stubs for routines that the user may define to
  4.  *  set up glue routines for C libraries or to decrypt encrypted scripts
  5.  *  for execution.
  6.  *
  7.  * $Log:    usersub.c,v $
  8.  * Revision 4.0.1.1  91/11/11  16:47:17  lwall
  9.  * patch19: deleted some unused functions from usersub.c
  10.  * 
  11.  * Revision 4.0  91/03/20  01:55:56  lwall
  12.  * 4.0 baseline.
  13.  * 
  14.  */
  15.  
  16. #include "EXTERN.h"
  17. #include "perl.h"
  18.  
  19. userinit()
  20. {
  21.     return 0;
  22. }
  23.  
  24. /* Be sure to refetch the stack pointer after calling these routines. */
  25.  
  26. int
  27. callback(subname, sp, gimme, hasargs, numargs)
  28. char *subname;
  29. int sp;            /* stack pointer after args are pushed */
  30. int gimme;        /* called in array or scalar context */
  31. int hasargs;        /* whether to create a @_ array for routine */
  32. int numargs;        /* how many args are pushed on the stack */
  33. {
  34.     static ARG myarg[3];    /* fake syntax tree node */
  35.     int arglast[3];
  36.     
  37.     arglast[2] = sp;
  38.     sp -= numargs;
  39.     arglast[1] = sp--;
  40.     arglast[0] = sp;
  41.  
  42.     if (!myarg[0].arg_ptr.arg_str)
  43.     myarg[0].arg_ptr.arg_str = str_make("",0);
  44.  
  45.     myarg[1].arg_type = A_WORD;
  46.     myarg[1].arg_ptr.arg_stab = stabent(subname, FALSE);
  47.  
  48.     myarg[2].arg_type = hasargs ? A_EXPR : A_NULL;
  49.  
  50.     return do_subr(myarg, gimme, arglast);
  51. }
  52.  
  53. int
  54. callv(subname, sp, gimme, argv)
  55. char *subname;
  56. register int sp;    /* current stack pointer */
  57. int gimme;        /* called in array or scalar context */
  58. register char **argv;    /* null terminated arg list, NULL for no arglist */
  59. {
  60.     register int items = 0;
  61.     int hasargs = (argv != 0);
  62.  
  63.     astore(stack, ++sp, Nullstr);    /* reserve spot for 1st return arg */
  64.     if (hasargs) {
  65.     while (*argv) {
  66.         astore(stack, ++sp, str_2mortal(str_make(*argv,0)));
  67.         items++;
  68.         argv++;
  69.     }
  70.     }
  71.     return callback(subname, sp, gimme, hasargs, items);
  72. }
  73.  
  74. /*
  75.  * The following is supplied by John Macdonald as a means of decrypting
  76.  * and executing (presumably proprietary) scripts that have been encrypted
  77.  * by a (presumably secret) method.  The idea is that you supply your own
  78.  * routine in place of cryptfilter (which is purposefully a very weak
  79.  * encryption).  If an encrypted script is detected, a process is forked
  80.  * off to run the cryptfilter routine as input to perl.
  81.  */
  82.  
  83. #ifdef CRYPTSCRIPT
  84.  
  85. #include <signal.h>
  86. #ifdef I_VFORK
  87. #include <vfork.h>
  88. #endif
  89.  
  90. #ifdef CRYPTLOCAL
  91.  
  92. #include "cryptlocal.h"
  93.  
  94. #else    /* ndef CRYPTLOCAL */
  95.  
  96. #define    CRYPT_MAGIC_1    0xfb
  97. #define    CRYPT_MAGIC_2    0xf1
  98.  
  99. cryptfilter( fil )
  100. FILE *    fil;
  101. {
  102.     int    ch;
  103.  
  104.     while( (ch = getc( fil )) != EOF ) {
  105.     putchar( (ch ^ 0x80) );
  106.     }
  107. }
  108.  
  109. #endif    /* CRYPTLOCAL */
  110.  
  111. #ifndef MSDOS
  112. static FILE    *lastpipefile;
  113. static int    pipepid;
  114.  
  115. #ifdef VOIDSIG
  116. #  define    VOID    void
  117. #else
  118. #  define    VOID    int
  119. #endif
  120.  
  121. FILE *
  122. mypfiopen(fil,func)        /* open a pipe to function call for input */
  123. FILE    *fil;
  124. VOID    (*func)();
  125. {
  126.     int p[2];
  127.     STR *str;
  128.  
  129.     if (pipe(p) < 0) {
  130.     fclose( fil );
  131.     fatal("Can't get pipe for decrypt");
  132.     }
  133.  
  134.     /* make sure that the child doesn't get anything extra */
  135.     fflush(stdout);
  136.     fflush(stderr);
  137.  
  138.     while ((pipepid = fork()) < 0) {
  139.     if (errno != EAGAIN) {
  140.         close(p[0]);
  141.         close(p[1]);
  142.         fclose( fil );
  143.         fatal("Can't fork for decrypt");
  144.     }
  145.     sleep(5);
  146.     }
  147.     if (pipepid == 0) {
  148.     close(p[0]);
  149.     if (p[1] != 1) {
  150.         dup2(p[1], 1);
  151.         close(p[1]);
  152.     }
  153.     (*func)(fil);
  154.     fflush(stdout);
  155.     fflush(stderr);
  156.     _exit(0);
  157.     }
  158.     close(p[1]);
  159.     close(fileno(fil));
  160.     fclose(fil);
  161.     str = afetch(fdpid,p[0],TRUE);
  162.     str->str_u.str_useful = pipepid;
  163.     return fdopen(p[0], "r");
  164. }
  165.  
  166. cryptswitch()
  167. {
  168.     int ch;
  169. #ifdef STDSTDIO
  170.     /* cheat on stdio if possible */
  171.     if (rsfp->_cnt > 0 && (*rsfp->_ptr & 0xff) != CRYPT_MAGIC_1)
  172.     return;
  173. #endif
  174.     ch = getc(rsfp);
  175.     if (ch == CRYPT_MAGIC_1) {
  176.     if (getc(rsfp) == CRYPT_MAGIC_2) {
  177.         if( perldb ) fatal("can't debug an encrypted script");
  178.         rsfp = mypfiopen( rsfp, cryptfilter );
  179.         preprocess = 1;    /* force call to pclose when done */
  180.     }
  181.     else
  182.         fatal( "bad encryption format" );
  183.     }
  184.     else
  185.     ungetc(ch,rsfp);
  186. }
  187. #endif /* !MSDOS */
  188.  
  189. #endif /* CRYPTSCRIPT */
  190.